'
'   XC Engine (project Minotaur)
'   Copyright (C) 2009 Stanislav Hordiyenko
'
'   This program is free software; you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation; either version 3 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program; if not, see http://www.gnu.org/licenses
'   or write to the Free Software Foundation,Inc., 51 Franklin Street,
'   Fifth Floor, Boston, MA 02110-1301 USA
'

Const adStateClosed = 0
Const adStateOpen = 1
Const adStateConnecting = 2
Const adStateExecuting = 4
Const adStateFetching = 8

Class Database
	Private objADODBConnection
	Private objRecordset
	Private objRecordCollection
	
	Private Sub Class_Initialize()
		Set objADODBConnection = Nothing
		Set objRecordset = Nothing
	End Sub
	
	Private Sub Class_Terminate()
		Set objADODBConnection = Nothing
		Set objRecordset = Nothing
	End Sub
	
	Private Property Get Connected
		If objADODBConnection.State = 1 Then
			Connected = True
		Else
			Connected = False
		End If
	End Property
	
	Public Sub Connect(strServerIp, strInitialCatalog, strUserId, strPassword)
		Set objADODBConnection = CreateObject("ADODB.Connection")
		Set objRecordset = CreateObject("ADODB.RecordSet")

		If strUserId <> "" And strPassword <> "" Then
			strConnectionString = "Provider=SQLOLEDB;data source={server ip};initial catalog={initial catalog};user id={user id};password={password};persist security info=True;packet size=4096;"
			strConnectionString = Replace(strConnectionString, "{user id}", strUserId)
			strConnectionString = Replace(strConnectionString, "{password}", strPassword)
		Else
			strConnectionString = "Provider=SQLOLEDB;Data Source={server ip};Integrated Security=SSPI;Initial Catalog={initial catalog}"
		End If
		
		strConnectionString = Replace(strConnectionString, "{server ip}", strServerIp)
		strConnectionString = Replace(strConnectionString, "{initial catalog}", strInitialCatalog)
		
		objADODBConnection.ConnectionTimeout = 60
		
		objADODBConnection.Open(strConnectionString)
	End Sub
	
	Public Sub Disconnect()
		If Connected Then	
			objADODBConnection.Close()
		End If
	End Sub
	
	Public Function ExecuteQuery(ByVal strSQLQuery)
		If Not Connected Then
			Err.Raise 5000, "Database->ExecuteQuery", "There is no connection to the database"
		
			Exit Function
		End If
	
		If objRecordset.State <> 0 Then objRecordset.Close()
	
		objRecordset.Open strSQLQuery, objADODBConnection, 3, 3
		
		Set ExecuteQuery = Me
	End Function
	
	Public Function ExecuteStoredProcedure(ByVal strStoredProcedureName, ByVal arrParameterValues)
		Set objCommand = CreateObject("ADODB.Command")

		objCommand.ActiveConnection = objADODBConnection
		objCommand.CommandText = strStoredProcedureName
		objCommand.CommandType = 4

		objCommand.Parameters.Refresh()

		For i=1 To UBound(arrParameterValues)+1
			objCommand.Parameters(i) = arrParameterValues(i-1)
		Next

		Set objRecordset = objCommand.Execute()
		Set ExecuteStoredProcedure = Me
	End Function
	
	Public Function ResultsToRecordSet()
		Set ResultsToRecordSet = objRecordset
	End Function
	
	Public Function ResultsToRecordCollection()
		Set objRecordCollection = New RecordCollection
	
		objRecordCollection.WrapRecordset(objRecordset) 
		
		Set ResultsToRecordCollection = objRecordCollection 
	End Function
End Class

Class RecordCollection
	Private objRecordset
	Private objSelectedRecord
	Private blnSelectedRecord
	
	Private Sub Class_Initialize()
		Set objRecordset = Nothing
		Set objSelectedRecord = Nothing
		
		blnSelectedRecord = False
	End Sub
	
	Private Sub Class_Terminate()
		Set objRecordset = Nothing
		Set objSelectedRecord = Nothing
	End Sub
	
	Public Function WrapRecordSet(ByVal objRecordsetParameter)
		Set objRecordset = objRecordsetParameter
	End Function
	
	Public Function Count()
		Count = objRecordset.RecordCount
	End Function
	
	Public Function FieldValue(ByVal strColumnName)
		If objSelectedRecord Is Nothing Then
			Err.Raise 5000, "RecordCollection->FieldValue", "There is no specified record"
			
			Exit Function
		End If
		
		'MsgBox IsNull(Null)
		
		'MsgBox TypeName(objSelectedRecord.Item(strColumnName))
		'MsgBox IsNull(objSelectedRecord.Item(strColumnName))
		'MsgBox IsNull(objSelectedRecord.Item(strColumnName).Value)
		
		If IsNull(objSelectedRecord.Item(strColumnName).Value) Then
			FieldValue = Null
		Else
			FieldValue = objSelectedRecord.Item(strColumnName).Value
		End If
		
		blnSelectedRecord = False
		
		Set objSelectedRecord = Nothing
	End Function
	
	Public Property Get Exists
		Exists = blnSelectedRecord
		blnSelectedRecord = False
		
		Set objSelectedRecord = Nothing
	End Property
	
	Public Function Record(ByVal varRecordProperties)
		Const vbString = 8
	
		Set Record = Nothing
	
		If VarType(varRecordProperties) = vbString Then
			Set objRecordProperties = RecordPropertiesToDictionary(varRecordProperties)
		
			objRecordset.MoveFirst()
			
			Do While Not objRecordset.Eof
				blnRecordExists = True
				
				For Each strKey In objRecordProperties.Keys
					' Null?? How? vbNull
					'CStr(objRecordProperties.Item(strKey)) <> CStr(objRecordset.Fields(strKey).Value) Or 
					If InStr(CStr(objRecordset.Fields(strKey).Value), CStr(objRecordProperties.Item(strKey))) = 0 Then
						blnRecordExists = False
						
						Exit For
					End If
				Next
				
				If blnRecordExists Then
					Set objSelectedRecord = objRecordset.Fields
					Set Record = Me
				
					blnSelectedRecord = True
				
					Exit Function
				End If
				
				objRecordset.MoveNext()
			Loop
			
			RecordExists = False
		Else
			varRecordProperties = CInt(varRecordProperties)
		
			If objRecordset.RecordCount < varRecordProperties Then Exit Function
			
			objRecordset.Move varRecordProperties
			
			Set objSelectedRecord = objRecordset.Fields
			Set Record = Me
			
			blnSelectedRecord = True
		End If
	End Function
	
	Private Function RecordPropertiesToDictionary(ByVal strRecordProperties)
		Set objRecordProperties = CreateObject("Scripting.Dictionary")
		
		arrRecordProperties = Split(strRecordProperties, "', ")

		For i=0 To UBound(arrRecordProperties)
			arrColumnValue = Split(arrRecordProperties(i), ": ")
			
			strColumnName = arrColumnValue(0)
			
			If UBound(arrColumnValue) > 1 Then
				For k=1 To UBound(arrColumnValue)
					strColumnValue = strColumnValue & arrColumnValue(k)
				Next
			Else
				strColumnValue = arrColumnValue(1)
			End If
			
			If Left(strColumnValue, 1) = "'" Then strColumnValue = Right(strColumnValue, Len(strColumnValue)-1)
			If Right(strColumnValue, 1) = "'" Then strColumnValue = Left(strColumnValue, Len(strColumnValue)-1)

			objRecordProperties.Add strColumnName, strColumnValue
		Next
		
		Set RecordPropertiesToDictionary = objRecordProperties
	End Function
	
	Public Sub Close()
		If objRecordset.State = adStateOpen Then
			objRecordset.Close()
		End If
		
		Set objRecordset = Nothing
	End Sub
End Class